home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / GFXFX2.ZIP / 3D_TRANS.PAS < prev    next >
Pascal/Delphi Source File  |  1995-02-14  |  5KB  |  169 lines
  1.  
  2. program transparency; { 3D_13H.PAS }
  3. { mode-13h version of polygoned objects, by Bas van Gaalen,
  4.   might be slow on some (or actualy most) computers }
  5. uses u_vga,u_pal,u_3d,u_kb;
  6.  
  7. const
  8.   fpoly=4;
  9.   nofpoints=8;
  10.   nofplanes=6;
  11.   points:array[1..nofpoints,0..2] of integer=(
  12.     (-40,-40,-40),(-40,-40,40),(40,-40,40),(40,-40,-40),
  13.     (-40, 40,-40),(-40, 40,40),(40, 40,40),(40, 40,-40));
  14.   planes:array[1..nofplanes,0..3] of byte=(
  15.     (1,5,6,2),(1,4,8,5),(1,2,3,4),(5,6,7,8),(8,7,3,4),(2,3,7,6));
  16.  
  17. var virscr:pointer;
  18.  
  19. procedure hlin(xb,xe,y:integer; c:byte); assembler;
  20. asm
  21.   mov cx,xb
  22.   jcxz @out
  23.   mov bx,cx
  24.   mov cx,xe
  25.   jcxz @out
  26.   cmp bx,cx
  27.   jb @skip
  28.   xchg bx,cx
  29.  @skip:
  30.   jcxz @out
  31.   inc cx
  32.   sub cx,bx
  33.   les di,destenation
  34.   mov ax,y
  35.   shl ax,6
  36.   add di,ax
  37.   shl ax,2
  38.   add di,ax
  39.   add di,bx
  40.   mov al,c
  41.  @l1:
  42.   add es:[di],al
  43.   inc di
  44.   loop @l1
  45.  @out:
  46. end;
  47.  
  48. function maxi(a,b:integer):integer; inline(
  49.   $58/        { pop   ax     }
  50.   $5b/        { pop   bx     }
  51.   $3b/$c3/    { cmp   ax,bx  }
  52.   $7f/$01/    { jg    +1     }
  53.   $93);       { xchg  ax,bx  }
  54.  
  55. function mini(a,b:integer):integer; inline(
  56.   $58/        { pop   ax     }
  57.   $5b/        { pop   bx     }
  58.   $3b/$c3/    { cmp   ax,bx  }
  59.   $7c/$01/    { jl    +1     }
  60.   $93);       { xchg  ax,bx  }
  61.  
  62. { inrange? }
  63. function ir(value,min,max:integer):integer; inline(
  64.   $59/        { pop   cx max }
  65.   $5b/        { pop   bx min }
  66.   $58/        { pop   ax val }
  67.   $3b/$c3/    { cmp   ax,bx  }
  68.   $7f/$03/    { jg    +3     }
  69.   $93/        { xchg  ax,bx  }
  70.   $eb/$05/    { jmp   +5     }
  71.   $3b/$c1/    { cmp   ax,cx  }
  72.   $7c/$01/    { jl    +1     }
  73.   $91);       { xchg  ax,cx  }
  74.  
  75. procedure tpolygon(x1,y1,x2,y2,x3,y3,x4,y4,xo,yo:integer; c:byte);
  76. var pos:array[0..199,0..1] of integer;
  77.   xdiv1,xdiv2,xdiv3,xdiv4,ydiv1,ydiv2,ydiv3,ydiv4,ly,gy,y:integer;
  78.   dir1,dir2,dir3,dir4:byte;
  79.   step:shortint;
  80. begin
  81.   { add offsets }
  82.   inc(x1,xo); inc(x2,xo); inc(x3,xo); inc(x4,xo);
  83.   inc(y1,yo); inc(y2,yo); inc(y3,yo); inc(y4,yo);
  84.   { determine highest and lowest point + vertical window checking }
  85.   ly:=maxi(mini(mini(mini(y1,y2),y3),y4),u_miny);
  86.   gy:=mini(maxi(maxi(maxi(y1,y2),y3),y4),u_maxy);
  87.   if ly>u_maxy then exit;
  88.   if gy<u_miny then exit;
  89.   { calculate constants }
  90.   dir1:=byte(y1<y2); xdiv1:=x2-x1; ydiv1:=y2-y1;
  91.   dir2:=byte(y2<y3); xdiv2:=x3-x2; ydiv2:=y3-y2;
  92.   dir3:=byte(y3<y4); xdiv3:=x4-x3; ydiv3:=y4-y3;
  93.   dir4:=byte(y4<y1); xdiv4:=x1-x4; ydiv4:=y1-y4;
  94.   y:=y1; step:=dir1 shl 1-1;
  95.   if y1<>y2 then repeat
  96.     if ir(y,ly,gy)=y then pos[y,dir1]:=ir(xdiv1*(y-y1) div ydiv1+x1,u_minx,u_maxx);
  97.     inc(y,step);
  98.   until y=y2+step
  99.   else if (y>=ly) and (y<=gy) then pos[y,dir1]:=ir(x1,u_minx,u_maxx);
  100.   y:=y2; step:=dir2 shl 1-1;
  101.   if y2<>y3 then repeat
  102.     if ir(y,ly,gy)=y then pos[y,dir2]:=ir(xdiv2*(y-y2) div ydiv2+x2,u_minx,u_maxx);
  103.     inc(y,step);
  104.   until y=y3+step
  105.   else if (y>=ly) and (y<=gy) then pos[y,dir2]:=ir(x2,u_minx,u_maxx);
  106.   y:=y3; step:=dir3 shl 1-1;
  107.   if y3<>y4 then repeat
  108.     if ir(y,ly,gy)=y then pos[y,dir3]:=ir(xdiv3*(y-y3) div ydiv3+x3,u_minx,u_maxx);
  109.     inc(y,step);
  110.   until y=y4+step
  111.   else if (y>=ly) and (y<=gy) then pos[y,dir3]:=ir(x3,u_minx,u_maxx);
  112.   y:=y4; step:=dir4 shl 1-1;
  113.   if y4<>y1 then repeat
  114.     if ir(y,ly,gy)=y then pos[y,dir4]:=ir(xdiv4*(y-y4) div ydiv4+x4,u_minx,u_maxx);
  115.     inc(y,step);
  116.   until y=y1+step
  117.   else if (y>=ly) and (y<=gy) then pos[y,dir4]:=ir(x4,u_minx,u_maxx);
  118.   for y:=ly to gy do hlin(pos[y,0],pos[y,1],y,c);
  119. end;
  120.  
  121. procedure rotate_object;
  122. const xst=3; yst=1; zst=-2;
  123. var
  124.   xp,yp,z:array[1..nofpoints] of integer;
  125.   x,y:integer;
  126.   n,phix,phiy,phiz:byte;
  127. begin
  128.   phix:=0; phiy:=128; phiz:=0;
  129.   fillchar(xp,sizeof(xp),0);
  130.   fillchar(yp,sizeof(yp),0);
  131.   fillchar(z,sizeof(z),0);
  132.   destenation:=virscr;
  133.   repeat
  134.     vretrace;
  135.     setborder(200);
  136.     cls(virscr,64000); { clear virtual screen }
  137.     for n:=1 to nofpoints do begin
  138.       x:=points[n,0]; y:=points[n,1]; z[n]:=points[n,2]; { get original object }
  139.       rotate(x,y,z[n],phix,phiy,phiz); { rotate it }
  140.       conv3dto2d(xp[n],yp[n],x,y,z[n]); { convert 3d points to 2d }
  141.     end;
  142.     for n:=1 to nofplanes do begin
  143.       polyz[n]:=(z[planes[n,0]]+z[planes[n,1]]+z[planes[n,2]]+z[planes[n,3]]) div 4;
  144.       pind[n]:=n;
  145.     end;
  146.     quicksort(nofplanes); { depth sort }
  147.     for n:=1 to nofplanes do { draw seperate planes }
  148.       tpolygon(xp[planes[pind[n],0]],yp[planes[pind[n],0]],
  149.               xp[planes[pind[n],1]],yp[planes[pind[n],1]],
  150.               xp[planes[pind[n],2]],yp[planes[pind[n],2]],
  151.               xp[planes[pind[n],3]],yp[planes[pind[n],3]],
  152.               160,100,2*pind[n]);
  153.     inc(phix,xst); inc(phiy,yst); inc(phiz,zst); { increase angles }
  154.     setborder(0);
  155.     flip(virscr,ptr(u_vidseg,0),64000); { display screen }
  156.   until keypressed;
  157. end;
  158.  
  159. var i,j:word;
  160. begin
  161.   setvideo($13);
  162.   {u_border:=true;}
  163.   getmem(virscr,64000); cls(virscr,64000);
  164.   for i:=0 to 63 do setrgb(i+1,10+i div 3,10+i div 3,30+i div 2);
  165.   rotate_object;
  166.   freemem(virscr,64000);
  167.   setvideo(u_lm);
  168. end.
  169.